DasyMapR - Περίπτωση χρήσης Οι αιτήσεις στο ΕΑΠ

install.packages("devtools")
library(devtools)
install_github("etsakl/DasyMapR", build_vignettes = TRUE)
library(DasyMapR)

data("candidates_addresses")
candidates_addresses <- candidates_addresses[order(candidates_addresses$country), 
    ]
kable(head(candidates_addresses, 10))

kable(candidates_addresses[round(runif(10, min = 11, max = nrow(candidates_addresses) - 
    10), 0), ])

kable(tail(candidates_addresses, 10))

# O παρακάτω κώδικας δεν τρέχει πάντα γιατί εξαρτάται απο την σύνδεση
# nama_10r_3popgdp <- get_eurostat(id = 'nama_10r_3popgdp' ,filters =
# list(time=2013),time_format = 'num')
POP_EL <- nama_10r_3popgdp[grep("^EL\\d{3}", nama_10r_3popgdp$geo), ]
kable(head(POP_EL))

POP_EL.30 <- nama_10r_3popgdp[grep("^EL30[1-6]", nama_10r_3popgdp$geo), ]

EAP.application.NUTS@data$POP <- unlist(sapply(EAP.application.NUTS$NUTS_ID, 
    FUN = function(x) POP_EL$values[match(x, POP_EL$geo)]))
EAP.application.NUTS[["appPerhab"]] <- round(EAP.application.NUTS@data$Freq/EAP.application.NUTS@data$POP, 
    0)
kable(head(EAP.application.NUTS))

dasymapPlot.leaflet(EAP.application.NUTS, 7)

EAP.application.NUTS.30 <- EAP.application.NUTS[grep("^EL30[1-6]", EAP.application.NUTS[["NUTS_ID"]]), 
    ]
EAP.application.NUTS.grid.30 <- etrsSurfacePar(EAP.application.NUTS.30, over.method.type = "MaxArea", 
    cell.size = 1000)

EAP.application.NUTS.grid.30 <- joinMaxAreaSurfaceDataFrames(the.surface = EAP.application.NUTS.30, 
    the.EtrsSurface = EAP.application.NUTS.grid.30)

# EAP.application.NUTS.grid.30<-EAP.application.NUTS.grid[grep('^EL30[1-6]',EAP.application.NUTS.grid[['NUTS_ID']]),]
dasymapPlot.leaflet(EAP.application.NUTS.grid.30, 11)

kable(head(EAP.application.NUTS.grid.30))

kable(head(GEOSTAT_grid_POP_1K_2011_V2_0_el))

GEO_POP_2011_rev <- etrsReverseCellCode(df = GEOSTAT_grid_POP_1K_2011_V2_0_el, 
    cell.code.col = 2)
GEO_POP_2011_rev <- GEO_POP_2011_rev[, c(1, 8)]

EAP.application.NUTS.grid.30 <- merge(EAP.application.NUTS.grid.30, by = 0, 
    GEO_POP_2011_rev, all = F)
row.names(EAP.application.NUTS.grid.30@data) <- sapply(slot(EAP.application.NUTS.grid.30, 
    "polygons"), function(x) slot(x, "ID"))

EAP.application.NUTS.grid.30@data$applicants <- round((EAP.application.NUTS.grid.30@data$appPerhab * 
    EAP.application.NUTS.grid.30@data$TOT_P)/1000, 0)

dasymapPlot.leaflet(EAP.application.NUTS.grid.30, 15)

EAP.application.NUTS.301 <- EAP.application.NUTS[grep("^EL30[123]", EAP.application.NUTS[["NUTS_ID"]]), 
    ]
# Διαιρούμε με το εμβαδό της νεάς μονάδας απαρίθμισης
EAP.application.NUTS.301 <- ActuallVal2Density(EAP.application.NUTS.301, surface.value.col = 5, 
    area.unit = 1e+06)
EAP.source.surface <- etrsSourceSurface(input.surface = EAP.application.NUTS.301, 
    over.method.type = "PropCal", surface.value.col = 7, cell.size = 500)

dasymapPlot(EAP.source.surface, 4)

kable(head(EAP.source.surface@data))

residential.areas <- clc_v2_code_11x_el[EAP.application.NUTS.301, ]
# residential.areas<-residential.areas[-10,]
bound301 = list(EAP.application.NUTS.301, border = 2, lwd = 2)
bound = list(EAP.application.NUTS)
spplot(residential.areas, "code_00", main = "Περιοχές Κατοικίας  CORINE", 
    sp.layout = list(bound, bound301), col.regions = c("yellow", "blue"))

ReDens111 <- round(3/4, 2)
ReDens112 <- round(1/4, 2)
residential.areas@data[which(residential.areas@data[, "code_00"] == 111), "ReDens"] <- ReDens111
residential.areas@data[which(residential.areas@data[, "code_00"] == 112), "ReDens"] <- ReDens112
residential.areas.anc <- etrsAncillarySurface(input.surface = residential.areas, 
    over.method.type = "PropCal", surface.value.col = 2, cell.size = 500, binary = F)

spplot(residential.areas.anc, "WCELLWEIGHT", main = "Περιοχές Κατοικίας  Βοηθητική Επιφάνεια / grided", 
    sp.layout = list(bound, bound301), edge.col = "lightgrey")

EAP.dasymetric.surface <- EtrsDasymetricSurface(input.surface.grided = EAP.source.surface, 
    ancillary.grided = residential.areas.anc)

EAP.dasymetric.surface[["DASYCELL"]] <- round(EAP.dasymetric.surface[["DASYCELL"]], 
    0)

dasymapPlot(EAP.dasymetric.surface, 6)
title(main = "Χάρτης αιτήσεων στο ΕΑΠ", sub = "Δασυμeτρική επιφάνεια")
plot(pc_regions[EAP.application.NUTS, ], border = "1", add = T, lty = 3)
kable(head(EAP.dasymetric.surface@data[, c(1, 6)]), col.names = c("Κωδικός Κελλιου", 
    "Αιτήσεις"))

dasymapPlot.leaflet(EAP.dasymetric.surface, 6)

candidates_addresses_el <- candidates_addresses[candidates_addresses$country %in% 
    "Ελλάδα", ]
kable(head(candidates_addresses_el, 10))

candidates_addresses_el$zipCode <- as.character(candidates_addresses_el$zipCode)
# αφαιρούνται σημεία στίξης αλλά και κενά απο ΤΚ
candidates_addresses_el$zipCode <- gsub("[[:space:]]", "", candidates_addresses_el$zipCode)
candidates_addresses_el$zipCode <- gsub("[[:punct:]]", "", candidates_addresses_el$zipCode)
# γράφουμε τοκ κωδικό σε μορφή Τ.Κ.
candidates_addresses_el$POSTCODE <- paste0(substring(candidates_addresses_el$zipCode, 
    1, 3), " ", substring(candidates_addresses_el$zipCode, 4, 5))
# Και αναζητούμε όσους δεν εχουν τιμή η έχουν τιμή που δεν είναι Τ.Κ
check_pc <- !(grepl("[[:digit:]]{3}[[:space:]][[:digit:]]{2}$", candidates_addresses_el$POSTCODE, 
    perl = T))
# Τι δεδομένα είναι αυτά? εξηγείται παρακάτω
data("pc_regions")
# απόδοση τιμών ΤΚ από τον πίνακα pc_regions με βάση την πολή
candidates_addresses_el_np <- subset(candidates_addresses_el, check_pc)
candidates_addresses_el_wp <- subset(candidates_addresses_el, !check_pc)
candidates_addresses_el_np$POSTCODE <- unlist(sapply(candidates_addresses_el_np$city, 
    FUN = function(x) as.character(pc_regions@data$POSTCODE[match(x, pc_regions$EDRA)])))
candidates_addresses_el <- rbind(candidates_addresses_el_wp, candidates_addresses_el_np)
# Και αναζητούμε όσους δεν εχουν τιμή η έχουν τιμή που δεν είναι Τ.Κ
check_pc <- (grepl("[[:digit:]]{3}[[:space:]][[:digit:]]{2}$", candidates_addresses_el$POSTCODE, 
    perl = T))
candidates_addresses_el <- subset(candidates_addresses_el, check_pc)
# Υπάρχουν Τ.Κ. θυρήδων Αθήνων οπότε αποδίδονται στην Αθήνα
check_pc <- grepl("[1]{1}[0]{1}[0-4]{1}[[:space:]][0-3]{1}[0]{1}", candidates_addresses_el$POSTCODE, 
    perl = T)
candidates_addresses_el[check_pc, "POSTCODE"] <- "104 31"
# Υπάρχουν Κωδικοί εξωτερικού ή που δεν μπορούν να συσχετιστουν
check_pc <- grepl("^[8-9]{1}[6-9]{1}[0-4]{1}[[:space:]][0-9]{1}[0-9]{1}", candidates_addresses_el$POSTCODE, 
    perl = T)
candidates_addresses_el_np <- subset(candidates_addresses_el, check_pc)
candidates_addresses_el_wp <- subset(candidates_addresses_el, !check_pc)
candidates_addresses_el_np$POSTCODE <- unlist(sapply(candidates_addresses_el_np$city, 
    FUN = function(x) as.character(pc_regions@data$POSTCODE[match(x, pc_regions$EDRA)])))
candidates_addresses_el <- rbind(candidates_addresses_el_wp, candidates_addresses_el_np)
check_pc <- grepl("^[8-9]{1}[6-9]{1}[0-4]{1}[[:space:]][0-9]{1}[0-9]{1}", candidates_addresses_el$POSTCODE, 
    perl = T)
candidates_addresses_el <- subset(candidates_addresses_el, !check_pc)
# Υπαρχουν κωδικοί που εμφανίζονται λίγες φορές με έλεγχο κρίθηκε ότι δεν
# αντιστοιχούνσε ΤΚ και αποδίδονται στα 3 πρώτα ψηφία
cnt_py <- count(candidates_addresses_el, vars = c("POSTCODE"))
cnt_py_lf <- subset(cnt_py, cnt_py$freq <= 20L)
cnt_py_hf <- subset(cnt_py, cnt_py$freq > 20L)
check_pc <- !is.na(match(candidates_addresses_el$POSTCODE, cnt_py_lf$POSTCODE))
candidates_addresses_el_wp <- subset(candidates_addresses_el, !check_pc)
candidates_addresses_el_np <- subset(candidates_addresses_el, check_pc)
candidates_addresses_el_np$POSTCODE <- unlist(sapply(candidates_addresses_el_np$POSTCODE, 
    FUN = function(x) as.character(pc_regions@data$POSTCODE[match(substring(x, 
        first = 1, last = 3), substring(pc_regions$POSTCODE, first = 1, last = 3))])))

candidates_addresses_el_cor <- rbind(na.exclude(candidates_addresses_el_np), 
    candidates_addresses_el_wp)

# Προσθέτω τυχαίες χρονιές αιτήσεων για χρήση ως παράδειγμα
year <- round(runif(nrow(candidates_addresses_el_cor), min = 1998, max = 2016), 
    0)
candidates_addresses_el_cor["YEAR"] <- year

kable(head(candidates_addresses_el, 10))

kable(head(pc_regions[, 1:12]))
kable(head(pc_regions[, 13:24]))

plot(pc_regions)

kable(head(candidates_addresses_el, 10))

data("pc_regions")

#'ΝΟΜΟΙ ΑΠΟ ΤΟ raw ΑΡΧΕΙΟ'
# #Διόρθωοη των 'νομών'
cnt_py_pre_err <- as.data.frame(table(candidates_addresses["pre"]))
colnames(cnt_py_pre) <- c("POSTCODE", "Freq")
# Αφαίρεση εγγραφών και απόδοση κωδικών
cnt_py_pre_err <- read.csv("cnt_py_pre_err.csv", sep = ",")
# Συσωμάτωση με το νομό ΙΙ
pc_regions_data <- pc_regions@data
pc_regions_data <- pc_regions_data[, c("PREF_ID", "PREFECTURE")]
pc_regions_data <- unique(pc_regions_data)
rownames(pc_regions_data) <- pc_regions_data$PREF_ID
pc_regions_sp <- unionSpatialPolygons(pc_regions, pc_regions@data$PREF_ID)
pc_regions_pref <- SpatialPolygonsDataFrame(pc_regions_sp, pc_regions_data)
# #Γεωαναφορά
EAP.application.pre_err <- merge(x = pc_regions_pref, y = cnt_py_pre_err, by = "PREF_ID")
EAP.application.pre_err@data[is.na(EAP.application.pre_err$Freq), "Freq"] <- 0L


# Συσσωμάτωση με βάση το ΤΚ
pc_regions_data <- pc_regions@data
pc_regions_data <- unique(pc_regions_data["POSTCODE"])
rownames(pc_regions_data) <- pc_regions_data$POSTCODE
pc_regions_sp <- unionSpatialPolygons(pc_regions, pc_regions@data$POSTCODE)
pc_regions_ag <- SpatialPolygonsDataFrame(pc_regions_sp, pc_regions_data)
# Γεωαναφορά
cnt_py_loc <- as.data.frame(table(candidates_addresses_el_cor["POSTCODE"]))
EAP.application.loc <- merge(x = pc_regions_ag, y = cnt_py_loc, by = "POSTCODE")
EAP.application.loc@data[is.na(EAP.application.loc$freq), "freq"] <- 0L

# Συσωμάτωση με το νομό ΙΙ
pc_regions_data <- pc_regions@data
pc_regions_data <- pc_regions_data[, c("PREF_ID", "PREFECTURE")]
pc_regions_data <- unique(pc_regions_data)
rownames(pc_regions_data) <- pc_regions_data$PREF_ID
pc_regions_sp <- unionSpatialPolygons(pc_regions, pc_regions@data$PREF_ID)
pc_regions_pref <- SpatialPolygonsDataFrame(pc_regions_sp, pc_regions_data)
# Γεωναφορά
EAP.application.pre <- merge(x = pc_regions_pref, y = cnt_py_pre_err, by = "PREF_ID")
EAP.application.pre@data[is.na(EAP.application.pre_err$Freq), "Freq"] <- 0L

#'ΝΟΜΟΙ ΑΠΟ ΤΟ raw ΑΡΧΕΙΟ' NUTS
EAP_NUTS_V9 <- read.csv("EAP_NUTS_V9.csv")
# Γεωαναφορά
GR <- NUTSV9_LEAC[which(!is.na(match(NUTSV9_LEAC[["N0CD"]], "GR"))), ]
EAP.NUTS <- merge(x = NUTSV9_LEAC, y = EAP_NUTS_V9, by.x = "N3CD", by.y = "NUTS_V9", 
    all.y = TRUE)
EAP.NUTS <- EAP.NUTS[which(!is.na(EAP.NUTS@data$PREF_ID)), ]

plot(perf)
applicants <- perf@data$freq
points(spsample(x = perf, n = applicants, type = "random"), pch = 1, cex = 0.5, 
    col = 2)

# Χρήση των pc_el_NUTS20xx
candidates_addresses_el_cor$NUTS_310 <- unlist(sapply(candidates_addresses_el_cor$POSTCODE, 
    FUN = function(x) as.character(pc_el_NUTS2010$NUTS_3[match(x, pc_el_NUTS2010$POSTCODE)])))

candidates_addresses_el_cor$NUTS_313 <- unlist(sapply(candidates_addresses_el_cor$POSTCODE, 
    FUN = function(x) as.character(pc_el_NUTS2013$NUTS_3[match(x, pc_el_NUTS2013$POSTCODE)])))

candidates_addresses_el_cor$NUTS_309 <- unlist(sapply(candidates_addresses_el_cor$pre, 
    FUN = function(x) as.character(EAP_NUTS_V9$NUTS_V9[match(x, EAP_NUTS_V9$pre)])))

candidates_addresses_el_cor$PREF_ID <- unlist(sapply(candidates_addresses_el_cor$POSTCODE, 
    FUN = function(x) as.character(pc_regions$PREF_ID[match(x, pc_regions$POSTCODE)])))